Intro

As an extra incentive for completing one of our studies, we planning to provide people with personalized feedback on their personality based on their responses to the HEXACO-60 questionnaire. In particular, we’ll tell people how their scores on the six traits compare to some norming data provided by the authors of the HEXACO at hexaco.org. For this portfolio, I’d like to try making some visualizations to be used in this feedback.

Making norming densities

Using the means and standard deviations from Ashton et al.’s norming data, I wanted to generate some normally distruted data that should roughly approximate the distribution of their study.

hexaco_norm <- data.frame(matrix(ncol = 0, nrow = 1126))

set.seed(1998)

hexaco_norm$hh <- rtruncnorm(1126, 1, 5, 3.23, .66)

hexaco_norm$em <- rtruncnorm(1126, 1, 5, 3.36, .7)

hexaco_norm$ex <- rtruncnorm(1126, 1, 5, 3.51, .62)

hexaco_norm$ag <- rtruncnorm(1126, 1, 5, 3.10, .63)

hexaco_norm$cn <- rtruncnorm(1126, 1, 5, 3.47, .61)

hexaco_norm$op <- rtruncnorm(1126, 1, 5, 3.49, .67)

Then, I want to plot these as density distributions. Because I make a lot of density distributions, and making them the way I like requires quite a bit of code, I decided I’d go ahead and write a function that does a lot of the ggplotting for me to make this process somewhat more efficient.

Below are the 6 distributions of scores we generated for each of the 6 traits based on Ashton et al.’s norming data.

library(rlang)
## 
## Attaching package: 'rlang'
## The following objects are masked from 'package:purrr':
## 
##     %@%, as_function, flatten, flatten_chr, flatten_dbl, flatten_int,
##     flatten_lgl, flatten_raw, invoke, splice
density_plot <- function(data, x, color, ymax, xmin, xmax, alpha) {
  ggplot2::ggplot(data = data, aes({{x}}))+
    geom_density(color = "black", fill = color, linewidth = 0.9, bw = 0.3, alpha = alpha)+
    theme_classic()+
    scale_y_continuous(
      limits = c(0, ymax),
      expand = c(0, 0))+
    scale_x_continuous(
      limits = c(xmin, xmax),
      expand = c(0, 0.01))
}

density_plot(hexaco_norm, hh, "gold1", 0.6, 1, 5, 0.5)

density_plot(hexaco_norm, em, "firebrick1", 0.6, 1, 5, 0.5)

density_plot(hexaco_norm, ex, "palegreen2", 0.6, 1, 5, 0.5)

density_plot(hexaco_norm, ag, "steelblue1", 0.6, 1, 5, 0.5)

density_plot(hexaco_norm, cn, "orange1", 0.7, 1, 5, 0.5)

density_plot(hexaco_norm, op, "purple1", 0.6, 1, 5, 0.5)

Now I want to try making an interactive plot that would show the percentile score (based on the norming data) for a given score on one of the HEXACO traits and graphically display how it compares to various percentiles. For this example, I used a hypothetical person who scores 3.4 out of a possible 5 mean score for Honesty-Humility (HH). This score is then converted to a percentile score and plotted against the distribution we generated for HH.

hexaco_norm$score <- rep(3.4, times = 1126)
hexaco_norm$Your_Score <- ecdf(hexaco_norm$hh)(hexaco_norm$score)

hexaco_norm <- hexaco_norm %>%
  mutate(Your_Score = round(Your_Score*100))
hhplot <- ggplot(hexaco_norm, aes(x = hh))+
  geom_density(color = "goldenrod4", fill = "gold1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
  geom_segment(aes(x = quantile(hh, probs = 0.5), y = 0, xend = quantile(hh, probs = 0.5), yend = 0.56, text = "Average"), color = "goldenrod4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
  geom_segment(aes(x = quantile(hh, probs = 0.01), y = 0.6, xend = quantile(hh, probs = 0.99), yend = 0.6), linewidth = 1, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.99), y = 0.6, text = "99th percentile"), size = 1.5, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.01), y = 0.6, text = "1st percentile"), size = 1.5, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.95), y = 0.6, text = "95th percentile"), size = 2, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.05), y = 0.6, text = "5th percentile"), size = 2, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.80), y = 0.6, text = "80th percentile"), size = 2.5, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.20), y = 0.6, text = "20th percentile"), size = 2.5, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.5), y = 0.6, text = "Average"), size = 4, color = "goldenrod3")+
  geom_segment(aes(x = score, y = 0, xend = score, yend = 0.6), color = "black", linewidth = 1)+
  geom_point(aes(x = score, y = 0.6, text = Your_Score), color = "black", size = 4.5)+
  geom_text(aes(x = score, y = 0.63, label = "Your Score"))+
    theme_void()+
    scale_y_continuous(
      limits = c(0, 0.7),
      expand = c(0, 0))
## Warning in geom_segment(aes(x = quantile(hh, probs = 0.5), y = 0, xend =
## quantile(hh, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.99), y = 0.6, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.01), y = 0.6, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.95), y = 0.6, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.05), y = 0.6, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.8), y = 0.6, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.2), y = 0.6, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.5), y = 0.6, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = score, y = 0.6, text = Your_Score), color =
## "black", : Ignoring unknown aesthetics: text
library(plotly)
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
ggplotly(hhplot, tooltip = "text")

Alright! Now that we got that to work, let’s try making a full personality profile for all 6 traits using existing data from a real participant in a past study.

Making 6 graphs for a real datapoint

real_data <- read.csv("data/hexaco scores.csv")
one_data <- real_data %>%
  filter(ID == 10)

#Getting HEXACO scores
hexaco_norm$op_score <- rep(one_data$openness, times = 1126)
hexaco_norm$ag_score <- rep(one_data$agreeableness, times = 1126)
hexaco_norm$ex_score <- rep(one_data$extraversion, times = 1126)
hexaco_norm$cn_score <- rep(one_data$conscientiousness, times = 1126)
hexaco_norm$hh_score <- rep(one_data$honestyhumility, times = 1126)
hexaco_norm$em_score <- rep(one_data$emotionality, times = 1126)

#Getting scores as percentiles
hexaco_norm$op_qscore <- ecdf(hexaco_norm$op)(hexaco_norm$op_score)
hexaco_norm$ag_qscore <- ecdf(hexaco_norm$ag)(hexaco_norm$ag_score)
hexaco_norm$ex_qscore <- ecdf(hexaco_norm$ex)(hexaco_norm$ex_score)
hexaco_norm$cn_qscore <- ecdf(hexaco_norm$cn)(hexaco_norm$cn_score)
hexaco_norm$hh_qscore <- ecdf(hexaco_norm$hh)(hexaco_norm$hh_score)
hexaco_norm$em_qscore <- ecdf(hexaco_norm$em)(hexaco_norm$em_score)

hexaco_norm <- hexaco_norm %>%
  mutate(op_qscore = round(op_qscore*100),
         ag_qscore = round(ag_qscore*100),
         ex_qscore = round(ex_qscore*100),
         cn_qscore = round(cn_qscore*100),
         hh_qscore = round(hh_qscore*100),
         em_qscore = round(em_qscore*100))

Openness

opplot <- ggplot(hexaco_norm, aes(x = op))+
  geom_density(color = "purple4", fill = "purple1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
  geom_segment(aes(x = quantile(op, probs = 0.5), y = 0, xend = quantile(op, probs = 0.5), yend = 0.55, text = "Average"), color = "purple4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
  geom_segment(aes(x = quantile(op, probs = 0.01), y = 0.6, xend = quantile(op, probs = 0.99), yend = 0.6), linewidth = 1, color = "purple3")+
  geom_point(aes(x = quantile(op, probs = 0.99), y = 0.6, text = "99th percentile"), size = 1.5, color = "purple3")+
  geom_point(aes(x = quantile(op, probs = 0.01), y = 0.6, text = "1st percentile"), size = 1.5, color = "purple3")+
  geom_point(aes(x = quantile(op, probs = 0.95), y = 0.6, text = "95th percentile"), size = 2, color = "purple3")+
  geom_point(aes(x = quantile(op, probs = 0.05), y = 0.6, text = "5th percentile"), size = 2, color = "purple3")+
  geom_point(aes(x = quantile(op, probs = 0.80), y = 0.6, text = "80th percentile"), size = 2.5, color = "purple3")+
  geom_point(aes(x = quantile(op, probs = 0.20), y = 0.6, text = "20th percentile"), size = 2.5, color = "purple3")+
  geom_point(aes(x = quantile(op, probs = 0.5), y = 0.6, text = "Average"), size = 4, color = "purple3")+
  geom_segment(aes(x = op_score, y = 0, xend = op_score, yend = 0.6), color = "black", linewidth = 1)+
  geom_point(aes(x = op_score, y = 0.6, text = op_qscore), color = "black", size = 4.5)+
  geom_text(aes(x = op_score, y = 0.63, label = "Your Score"))+
    theme_void()+
    scale_y_continuous(
      limits = c(0, 0.7),
      expand = c(0, 0))+
  labs(title = "Openness to Experience")
## Warning in geom_segment(aes(x = quantile(op, probs = 0.5), y = 0, xend =
## quantile(op, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.99), y = 0.6, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.01), y = 0.6, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.95), y = 0.6, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.05), y = 0.6, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.8), y = 0.6, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.2), y = 0.6, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.5), y = 0.6, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = op_score, y = 0.6, text = op_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(opplot, tooltip = "text")

Agreeableness

agplot <- ggplot(hexaco_norm, aes(x = ag))+
  geom_density(color = "steelblue4", fill = "steelblue1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
  geom_segment(aes(x = quantile(ag, probs = 0.5), y = 0, xend = quantile(ag, probs = 0.5), yend = 0.55, text = "Average"), color = "steelblue4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
  geom_segment(aes(x = quantile(ag, probs = 0.01), y = 0.65, xend = quantile(ag, probs = 0.99), yend = 0.65), linewidth = 1, color = "steelblue3")+
  geom_point(aes(x = quantile(ag, probs = 0.99), y = 0.65, text = "99th percentile"), size = 1.5, color = "steelblue3")+
  geom_point(aes(x = quantile(ag, probs = 0.01), y = 0.65, text = "1st percentile"), size = 1.5, color = "steelblue3")+
  geom_point(aes(x = quantile(ag, probs = 0.95), y = 0.65, text = "95th percentile"), size = 2, color = "steelblue3")+
  geom_point(aes(x = quantile(ag, probs = 0.05), y = 0.65, text = "5th percentile"), size = 2, color = "steelblue3")+
  geom_point(aes(x = quantile(ag, probs = 0.80), y = 0.65, text = "80th percentile"), size = 2.5, color = "steelblue3")+
  geom_point(aes(x = quantile(ag, probs = 0.20), y = 0.65, text = "20th percentile"), size = 2.5, color = "steelblue3")+
  geom_point(aes(x = quantile(ag, probs = 0.5), y = 0.65, text = "Average"), size = 4, color = "steelblue3")+
  geom_segment(aes(x = ag_score, y = 0, xend = ag_score, yend = 0.65), color = "black", linewidth = 1)+
  geom_point(aes(x = ag_score, y = 0.65, text = ag_qscore), color = "black", size = 4.5)+
  geom_text(aes(x = ag_score, y = 0.68, label = "Your Score"))+
    theme_void()+
    scale_y_continuous(
      limits = c(0, 0.75),
      expand = c(0, 0))+
  labs(title = "Agreeableness")
## Warning in geom_segment(aes(x = quantile(ag, probs = 0.5), y = 0, xend =
## quantile(ag, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.99), y = 0.65, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.01), y = 0.65, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.95), y = 0.65, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.05), y = 0.65, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.8), y = 0.65, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.2), y = 0.65, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.5), y = 0.65, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = ag_score, y = 0.65, text = ag_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(agplot, tooltip = "text")

Extraversion

explot <- ggplot(hexaco_norm, aes(x = ex))+
  geom_density(color = "forestgreen", fill = "palegreen1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
  geom_segment(aes(x = quantile(ex, probs = 0.5), y = 0, xend = quantile(ex, probs = 0.5), yend = 0.58, text = "Average"), color = "forestgreen", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
  geom_segment(aes(x = quantile(ex, probs = 0.01), y = 0.65, xend = quantile(ex, probs = 0.99), yend = 0.65), linewidth = 1, color = "palegreen3")+
  geom_point(aes(x = quantile(ex, probs = 0.99), y = 0.65, text = "99th percentile"), size = 1.5, color = "palegreen3")+
  geom_point(aes(x = quantile(ex, probs = 0.01), y = 0.65, text = "1st percentile"), size = 1.5, color = "palegreen3")+
  geom_point(aes(x = quantile(ex, probs = 0.95), y = 0.65, text = "95th percentile"), size = 2, color = "palegreen3")+
  geom_point(aes(x = quantile(ex, probs = 0.05), y = 0.65, text = "5th percentile"), size = 2, color = "palegreen3")+
  geom_point(aes(x = quantile(ex, probs = 0.80), y = 0.65, text = "80th percentile"), size = 2.5, color = "palegreen3")+
  geom_point(aes(x = quantile(ex, probs = 0.20), y = 0.65, text = "20th percentile"), size = 2.5, color = "palegreen3")+
  geom_point(aes(x = quantile(ex, probs = 0.5), y = 0.65, text = "Average"), size = 4, color = "palegreen3")+
  geom_segment(aes(x = ex_score, y = 0, xend = ex_score, yend = 0.65), color = "black", linewidth = 1)+
  geom_point(aes(x = ex_score, y = 0.65, text = ex_qscore), color = "black", size = 4.5)+
  geom_text(aes(x = ex_score, y = 0.68, label = "Your Score"))+
    theme_void()+
    scale_y_continuous(
      limits = c(0, 0.75),
      expand = c(0, 0))+
  labs(title = "Extraversion")
## Warning in geom_segment(aes(x = quantile(ex, probs = 0.5), y = 0, xend =
## quantile(ex, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.99), y = 0.65, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.01), y = 0.65, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.95), y = 0.65, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.05), y = 0.65, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.8), y = 0.65, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.2), y = 0.65, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.5), y = 0.65, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = ex_score, y = 0.65, text = ex_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(explot, tooltip = "text")

Honesty-Humility

hhplot <- ggplot(hexaco_norm, aes(x = hh))+
  geom_density(color = "goldenrod4", fill = "gold1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
  geom_segment(aes(x = quantile(hh, probs = 0.5), y = 0, xend = quantile(hh, probs = 0.5), yend = 0.54, text = "Average"), color = "goldenrod4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
  geom_segment(aes(x = quantile(hh, probs = 0.01), y = 0.6, xend = quantile(hh, probs = 0.99), yend = 0.6), linewidth = 1, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.99), y = 0.6, text = "99th percentile"), size = 1.5, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.01), y = 0.6, text = "1st percentile"), size = 1.5, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.95), y = 0.6, text = "95th percentile"), size = 2, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.05), y = 0.6, text = "5th percentile"), size = 2, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.80), y = 0.6, text = "80th percentile"), size = 2.5, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.20), y = 0.6, text = "20th percentile"), size = 2.5, color = "goldenrod3")+
  geom_point(aes(x = quantile(hh, probs = 0.5), y = 0.6, text = "Average"), size = 4, color = "goldenrod3")+
  geom_segment(aes(x = hh_score, y = 0, xend = hh_score, yend = 0.6), color = "black", linewidth = 1)+
  geom_point(aes(x = hh_score, y = 0.6, text = hh_qscore), color = "black", size = 4.5)+
  geom_text(aes(x = hh_score, y = 0.63, label = "Your Score"))+
    theme_void()+
    scale_y_continuous(
      limits = c(0, 0.7),
      expand = c(0, 0))+
  labs(title = "Honesty-Humility")
## Warning in geom_segment(aes(x = quantile(hh, probs = 0.5), y = 0, xend =
## quantile(hh, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.99), y = 0.6, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.01), y = 0.6, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.95), y = 0.6, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.05), y = 0.6, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.8), y = 0.6, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.2), y = 0.6, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.5), y = 0.6, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = hh_score, y = 0.6, text = hh_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(hhplot, tooltip = "text")

Conscientiousness

cnplot <- ggplot(hexaco_norm, aes(x = cn))+
  geom_density(color = "orange4", fill = "orange1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
  geom_segment(aes(x = quantile(cn, probs = 0.5), y = 0, xend = quantile(cn, probs = 0.5), yend = 0.58, text = "Average"), color = "orange4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
  geom_segment(aes(x = quantile(cn, probs = 0.01), y = 0.65, xend = quantile(cn, probs = 0.99), yend = 0.65), linewidth = 1, color = "orange3")+
  geom_point(aes(x = quantile(cn, probs = 0.99), y = 0.65, text = "99th percentile"), size = 1.5, color = "orange3")+
  geom_point(aes(x = quantile(cn, probs = 0.01), y = 0.65, text = "1st percentile"), size = 1.5, color = "orange3")+
  geom_point(aes(x = quantile(cn, probs = 0.95), y = 0.65, text = "95th percentile"), size = 2, color = "orange3")+
  geom_point(aes(x = quantile(cn, probs = 0.05), y = 0.65, text = "5th percentile"), size = 2, color = "orange3")+
  geom_point(aes(x = quantile(cn, probs = 0.80), y = 0.65, text = "80th percentile"), size = 2.5, color = "orange3")+
  geom_point(aes(x = quantile(cn, probs = 0.20), y = 0.65, text = "20th percentile"), size = 2.5, color = "orange3")+
  geom_point(aes(x = quantile(cn, probs = 0.5), y = 0.65, text = "Average"), size = 4, color = "orange3")+
  geom_segment(aes(x = cn_score, y = 0, xend = cn_score, yend = 0.65), color = "black", linewidth = 1)+
  geom_point(aes(x = cn_score, y = 0.65, text = cn_qscore), color = "black", size = 4.5)+
  geom_text(aes(x = cn_score, y = 0.68, label = "Your Score"))+
    theme_void()+
    scale_y_continuous(
      limits = c(0, 0.75),
      expand = c(0, 0))+
  labs(title = "Conscientiousness")
## Warning in geom_segment(aes(x = quantile(cn, probs = 0.5), y = 0, xend =
## quantile(cn, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.99), y = 0.65, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.01), y = 0.65, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.95), y = 0.65, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.05), y = 0.65, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.8), y = 0.65, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.2), y = 0.65, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.5), y = 0.65, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = cn_score, y = 0.65, text = cn_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(cnplot, tooltip = "text")

Emotionality

emplot <- ggplot(hexaco_norm, aes(x = em))+
  geom_density(color = "firebrick4", fill = "firebrick1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
  geom_segment(aes(x = quantile(em, probs = 0.5), y = 0, xend = quantile(em, probs = 0.5), yend = 0.53, text = "Average"), color = "firebrick", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
  geom_segment(aes(x = quantile(em, probs = 0.01), y = 0.6, xend = quantile(em, probs = 0.99), yend = 0.6), linewidth = 1, color = "firebrick")+
  geom_point(aes(x = quantile(em, probs = 0.99), y = 0.6, text = "99th percentile"), size = 1.5, color = "firebrick")+
  geom_point(aes(x = quantile(em, probs = 0.01), y = 0.6, text = "1st percentile"), size = 1.5, color = "firebrick")+
  geom_point(aes(x = quantile(em, probs = 0.95), y = 0.6, text = "95th percentile"), size = 2, color = "firebrick")+
  geom_point(aes(x = quantile(em, probs = 0.05), y = 0.6, text = "5th percentile"), size = 2, color = "firebrick")+
  geom_point(aes(x = quantile(em, probs = 0.80), y = 0.6, text = "80th percentile"), size = 2.5, color = "firebrick")+
  geom_point(aes(x = quantile(em, probs = 0.20), y = 0.6, text = "20th percentile"), size = 2.5, color = "firebrick")+
  geom_point(aes(x = quantile(em, probs = 0.5), y = 0.6, text = "Average"), size = 4, color = "firebrick")+
  geom_segment(aes(x = em_score, y = 0, xend = em_score, yend = 0.6), color = "black", linewidth = 1)+
  geom_point(aes(x = em_score, y = 0.6, text = em_qscore), color = "black", size = 4.5)+
  geom_text(aes(x = em_score, y = 0.63, label = "Your Score"))+
    theme_void()+
    scale_y_continuous(
      limits = c(0, 0.7),
      expand = c(0, 0))+
  labs(title = "Emotionality")
## Warning in geom_segment(aes(x = quantile(em, probs = 0.5), y = 0, xend =
## quantile(em, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.99), y = 0.6, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.01), y = 0.6, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.95), y = 0.6, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.05), y = 0.6, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.8), y = 0.6, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.2), y = 0.6, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.5), y = 0.6, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = em_score, y = 0.6, text = em_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(emplot, tooltip = "text")

It worked!

Making the process semi-automatic

I’m interested in trying to make this process more or less automatic so that it can be performed easily in a short amount of time for lots of participants. My first approach was to just stick everything I had just done into a function. This almost works, except the function will ultimately only spit out one of the 6 plots we want.

After this, I decided to implement things a slightly different way by writing a slightly different function and implementing it into an R Markdown document that, when knit, will automatically generate an html file with a HEXACO report for the person specified. I can add some more explanatory text to this file, and then it will be about ready to go for our purposes!

trait_output(real_data, 11)